home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / srcuc.zip / GCCODE.H < prev    next >
C/C++ Source or Header  |  1992-02-03  |  13KB  |  472 lines
  1. /* -*-C-*-
  2.  
  3. $Header: /scheme/src/microcode/RCS/gccode.h,v 9.45 1992/02/03 23:28:28 jinx Exp $
  4.  
  5. Copyright (c) 1987-92 Massachusetts Institute of Technology
  6.  
  7. This material was developed by the Scheme project at the Massachusetts
  8. Institute of Technology, Department of Electrical Engineering and
  9. Computer Science.  Permission to copy this software, to redistribute
  10. it, and to use it for any purpose is granted, subject to the following
  11. restrictions and understandings.
  12.  
  13. 1. Any copy made of this software must include this copyright notice
  14. in full.
  15.  
  16. 2. Users of this software agree to make their best efforts (a) to
  17. return to the MIT Scheme project any improvements or extensions that
  18. they make, so that these may be included in future releases; and (b)
  19. to inform MIT of noteworthy uses of this software.
  20.  
  21. 3. All materials developed as a consequence of the use of this
  22. software shall duly acknowledge such use, in accordance with the usual
  23. standards of acknowledging credit in academic research.
  24.  
  25. 4. MIT has made no warrantee or representation that the operation of
  26. this software will be error-free, and MIT is under no obligation to
  27. provide any services, by way of maintenance, update, or otherwise.
  28.  
  29. 5. In conjunction with products arising from the use of this material,
  30. there shall be no use of the name of the Massachusetts Institute of
  31. Technology nor of any adaptation thereof in any advertising,
  32. promotional, or sales literature without prior written consent from
  33. MIT in each case. */
  34.  
  35. /* This file contains the macros for use in code which does GC-like
  36.    loops over memory.  It is only included in a few files, unlike
  37.    gc.h which contains general purpose macros and constants. */
  38.  
  39. #ifdef ENABLE_DEBUGGING_TOOLS
  40. #ifndef ENABLE_GC_DEBUGGING_TOOLS
  41. #define ENABLE_GC_DEBUGGING_TOOLS
  42. #endif
  43. #endif
  44.  
  45. /* A SWITCH on GC types, duplicates information in GC_Type_Map[], but
  46.    exists for efficiency reasons. Macros must be used by convention:
  47.    first Switch_by_GC_Type, then each of the case_ macros (in any
  48.    order).  The default: case MUST be included in the switch. */
  49.  
  50. #define Switch_by_GC_Type(P)                 \
  51.   switch (OBJECT_TYPE (P))
  52.  
  53. #define case_simple_Non_Pointer                \
  54.   case TC_NULL:                        \
  55.   case TC_TRUE:                        \
  56.   case TC_RETURN_CODE:                    \
  57.   case TC_THE_ENVIRONMENT
  58.  
  59. #define case_Fasload_Non_Pointer            \
  60.   case TC_FIXNUM:                    \
  61.   case TC_CHARACTER:                    \
  62.   case_simple_Non_Pointer
  63.  
  64. #define case_Non_Pointer                \
  65.   case TC_PRIMITIVE:                    \
  66.   case TC_PCOMB0:                    \
  67.   case TC_STACK_ENVIRONMENT:                \
  68.   case_Fasload_Non_Pointer
  69.  
  70. /* Missing Non Pointer types (must always be treated specially):
  71.    TC_BROKEN_HEART
  72.    TC_MANIFEST_NM_VECTOR
  73.    TC_MANIFEST_SPECIAL_NM_VECTOR
  74.    TC_REFERENCE_TRAP
  75.    TC_MANIFEST_CLOSURE
  76.    TC_LINKAGE_SECTION */
  77.  
  78. #define case_compiled_entry_point            \
  79.  case TC_COMPILED_ENTRY
  80.  
  81. #define case_Cell                    \
  82.  case TC_CELL
  83.  
  84. /* No missing Cell types */
  85.  
  86. #define case_Fasdump_Pair                \
  87.  case TC_LIST:                        \
  88.  case TC_SCODE_QUOTE:                    \
  89.  case TC_COMBINATION_1:                    \
  90.  case TC_EXTENDED_PROCEDURE:                \
  91.  case TC_PROCEDURE:                    \
  92.  case TC_DELAY:                        \
  93.  case TC_DELAYED:                    \
  94.  case TC_COMMENT:                    \
  95.  case TC_LAMBDA:                    \
  96.  case TC_SEQUENCE_2:                    \
  97.  case TC_PCOMB1:                    \
  98.  case TC_ACCESS:                    \
  99.  case TC_DEFINITION:                    \
  100.  case TC_ASSIGNMENT:                    \
  101.  case TC_IN_PACKAGE:                    \
  102.  case TC_LEXPR:                        \
  103.  case TC_DISJUNCTION:                    \
  104.  case TC_COMPLEX:                    \
  105.  case TC_ENTITY:                    \
  106.  case TC_RATNUM
  107.  
  108. #define case_Pair                    \
  109.  case TC_INTERNED_SYMBOL:                \
  110.  case TC_UNINTERNED_SYMBOL:                \
  111.  case_Fasdump_Pair
  112.  
  113. /* Missing pair types (must be treated specially):
  114.    TC_WEAK_CONS */
  115.  
  116. #define case_Triple                    \
  117.  case TC_COMBINATION_2:                    \
  118.  case TC_EXTENDED_LAMBDA:                \
  119.  case TC_HUNK3_A:                    \
  120.  case TC_HUNK3_B:                    \
  121.  case TC_CONDITIONAL:                    \
  122.  case TC_SEQUENCE_3:                    \
  123.  case TC_PCOMB2
  124.  
  125. /* Missing triple types (must be treated specially):
  126.    TC_VARIABLE */
  127.  
  128. #define case_Quadruple                    \
  129.   case TC_QUAD
  130.  
  131. /* No missing quad types. */
  132.  
  133. #define case_simple_Vector                \
  134.  case TC_NON_MARKED_VECTOR:                \
  135.  case TC_VECTOR:                    \
  136.  case TC_CONTROL_POINT:                    \
  137.  case TC_COMBINATION:                    \
  138.  case TC_PCOMB3:                    \
  139.  case TC_VECTOR_1B:                    \
  140.  case TC_VECTOR_16B
  141.  
  142. #define case_Purify_Vector                \
  143.  case TC_BIG_FIXNUM:                    \
  144.  case TC_CHARACTER_STRING:                \
  145.  case_simple_Vector
  146.  
  147. #define case_Vector                    \
  148.  case TC_ENVIRONMENT:                    \
  149.  case TC_COMPILED_CODE_BLOCK:                \
  150.  case_Purify_Vector
  151.  
  152. /* Missing vector types (must be treated specially):
  153.    TC_FUTURE
  154.    TC_BIG_FLONUM */
  155.  
  156. extern char gc_death_message_buffer [];
  157.  
  158. extern void
  159.   EXFUN (gc_death, (long code, char *, SCHEME_OBJECT *, SCHEME_OBJECT *));
  160.  
  161. /* Assumption: A call to GC_BAD_TYPE is followed by the non-pointer code. */
  162.  
  163. #ifndef BAD_TYPES_INNOCUOUS
  164.  
  165. #define GC_BAD_TYPE(name)                        \
  166. do                                    \
  167. {                                    \
  168.   sprintf                                \
  169.     (gc_death_message_buffer,                        \
  170.      "%s: bad type code (0x%02x)",                    \
  171.      (name),                                \
  172.      (OBJECT_TYPE (Temp)));                        \
  173.   gc_death                                \
  174.     (TERM_INVALID_TYPE_CODE,                        \
  175.      gc_death_message_buffer,                        \
  176.      Scan,                                \
  177.      To);                                \
  178.   /*NOTREACHED*/                            \
  179. } while (0)
  180.  
  181. #else /* BAD_TYPES_INNOCUOUS */
  182.  
  183. #define GC_BAD_TYPE(name)                        \
  184. do                                    \
  185. {                                    \
  186.   fprintf                                \
  187.     (stderr,                                \
  188.      "\n%s: bad type code (0x%02x) 0x%lx",                \
  189.      (name),                                \
  190.      (OBJECT_TYPE (Temp)),                        \
  191.      Temp);                                \
  192.   fprintf (stderr, " -- Treating as non-pointer.\n");            \
  193.   /* Fall through */                            \
  194. } while (0)
  195.  
  196. #endif /* BAD_TYPES_INNOCUOUS */
  197.  
  198. /* Macros for the garbage collector and related programs. */
  199.  
  200. /* Pointer setup for the GC Type handlers. */
  201.  
  202. #define GC_Consistency_Check(In_GC)                    \
  203. {                                    \
  204.   if And2 (In_GC, Consistency_Check)                    \
  205.   {                                    \
  206.     if ((Old >= Highest_Allocated_Address) || (Old < Heap))        \
  207.     {                                    \
  208.       sprintf                                \
  209.     (gc_death_message_buffer,                    \
  210.      "setup_internal: out of range pointer (0x%lx)",        \
  211.      Temp);                                \
  212.       gc_death (TERM_EXIT, gc_death_message_buffer, Scan, To);        \
  213.       /*NOTREACHED*/                            \
  214.     }                                    \
  215.   }                                    \
  216. }
  217.  
  218. /* Check whether it has been relocated. */
  219.  
  220. #define Normal_BH(In_GC, then_what)                    \
  221. {                                    \
  222.   if (BROKEN_HEART_P (*Old))                        \
  223.   {                                    \
  224.     *Scan = (MAKE_OBJECT_FROM_OBJECTS (Temp, (*Old)));            \
  225.     then_what;                                \
  226.   }                                    \
  227. }
  228.  
  229. #define Setup_Internal(In_GC, Transport_Code, Already_Relocated_Code)    \
  230. {                                    \
  231.   GC_Consistency_Check (In_GC);                        \
  232.   if (Old >= Low_Constant)                        \
  233.     continue;                                \
  234.   Already_Relocated_Code;                        \
  235.   New_Address = (MAKE_BROKEN_HEART (To));                \
  236.   Transport_Code;                            \
  237. }
  238.  
  239. #define Setup_Pointer(In_GC, Transport_Code)                \
  240. {                                    \
  241.   Setup_Internal (In_GC, Transport_Code, Normal_BH (In_GC, continue));    \
  242. }
  243.  
  244. #define Pointer_End()                            \
  245. {                                    \
  246.   (* (OBJECT_ADDRESS (Temp))) = New_Address;                \
  247.   (* Scan) = (MAKE_OBJECT_FROM_OBJECTS (Temp, New_Address));        \
  248. }
  249.  
  250. /* GC Type handlers.  These do the actual work. */
  251.  
  252. #define Transport_Cell()                        \
  253. {                                    \
  254.   (*To++) = (*Old);                            \
  255.   Pointer_End ();                            \
  256. }
  257.  
  258. #define Transport_Pair()                        \
  259. {                                    \
  260.   (*To++) = (*Old++);                            \
  261.   (*To++) = (*Old);                            \
  262.   Pointer_End ();                            \
  263. }
  264.  
  265. #define Transport_Triple()                        \
  266. {                                    \
  267.   (*To++) = (*Old++);                            \
  268.   (*To++) = (*Old++);                            \
  269.   (*To++) = (*Old);                            \
  270.   Pointer_End ();                            \
  271. }
  272.  
  273. #define Transport_Quadruple()                        \
  274. {                                    \
  275.   (*To++) = (*Old++);                            \
  276.   (*To++) = (*Old++);                            \
  277.   (*To++) = (*Old++);                            \
  278.   (*To++) = (*Old);                            \
  279.   Pointer_End ();                            \
  280. }
  281.  
  282. #ifndef In_Fasdump
  283.  
  284. /* The OBJECT_DATUM below gets the length of the vector.
  285.    (VECTOR_LENGTH (Temp)) cannot be used because Temp does
  286.    not necessarily point to the first word of the object.
  287.    Currently only compiled entry points point to the
  288.    "middle" of vectors. */
  289.  
  290. #ifdef ENABLE_GC_DEBUGGING_TOOLS
  291.  
  292. #define CHECK_TRANSPORT_VECTOR_TERMINATION()                \
  293. {                                    \
  294.   if (! ((To <= Scan)                            \
  295.      && (((Constant_Space <= To) && (To < Constant_Top))        \
  296.          ? ((Constant_Space <= Scan) && (Scan < Constant_Top))    \
  297.          : ((Heap_Bottom <= Scan) && (Scan < Heap_Top)))))        \
  298.     {                                    \
  299.       fprintf (stderr, "\nBad transport_vector limit:\n");        \
  300.       fprintf (stderr, "  limit = 0x%lx\n", ((long) Scan));        \
  301.       fprintf (stderr, "  Scan = 0x%lx\n", ((long) Saved_Scan));    \
  302.       fprintf (stderr, "  To = 0x%lx\n", ((long) To));            \
  303.       fflush (stderr);                            \
  304.       abort ();                                \
  305.     }                                    \
  306.   if ((OBJECT_DATUM (*Old)) > 65536)                    \
  307.     {                                    \
  308.       fprintf (stderr, "\nWarning: copying large vector: %d\n",        \
  309.            (OBJECT_DATUM (*Old)));                    \
  310.       fflush (stderr);                            \
  311.     }                                    \
  312. }
  313.  
  314. #else /* not ENABLE_GC_DEBUGGING_TOOLS */
  315.  
  316. #define CHECK_TRANSPORT_VECTOR_TERMINATION()
  317.  
  318. #endif /* not ENABLE_GC_DEBUGGING_TOOLS */
  319.  
  320. #define Real_Transport_Vector()                        \
  321. {                                    \
  322.   SCHEME_OBJECT *Saved_Scan;                        \
  323.                                     \
  324.   Saved_Scan = Scan;                            \
  325.   Scan = (To + 1 + (OBJECT_DATUM (*Old)));                \
  326.   if ((Consistency_Check) &&                        \
  327.       (Scan >= Low_Constant) &&                        \
  328.       (To < Low_Constant))                        \
  329.     {                                    \
  330.       sprintf                                \
  331.     (gc_death_message_buffer,                    \
  332.      "real_transport_vector: vector length too large (%d)",        \
  333.      (OBJECT_DATUM (*Old)));                    \
  334.       gc_death (TERM_EXIT, gc_death_message_buffer, Saved_Scan, To);    \
  335.     }                                    \
  336.   CHECK_TRANSPORT_VECTOR_TERMINATION ();                \
  337.   while (To != Scan)                            \
  338.     (*To++) = (*Old++);                            \
  339.   Scan = Saved_Scan;                            \
  340. }
  341.  
  342. #else /* In_Fasdump */
  343.  
  344. #define Real_Transport_Vector()                        \
  345. {                                    \
  346.   SCHEME_OBJECT * Saved_Scan;                        \
  347.                                     \
  348.   Saved_Scan = Scan;                            \
  349.   Scan = (To + 1 + (OBJECT_DATUM (*Old)));                \
  350.   if (Scan >= Fixes)                            \
  351.     {                                    \
  352.       Scan = Saved_Scan;                        \
  353.       NewFree = To;                            \
  354.       Fixup = Fixes;                            \
  355.       return (PRIM_INTERRUPT);                        \
  356.     }                                    \
  357.   while (To != Scan)                            \
  358.     (*To++) = (*Old++);                            \
  359.   Scan = Saved_Scan;                            \
  360. }
  361.  
  362. #endif
  363.  
  364. #define Transport_Vector()                        \
  365. {                                    \
  366.  Move_Vector:                                \
  367.   Real_Transport_Vector ();                        \
  368.   Pointer_End ();                            \
  369. }
  370. #ifdef FLOATING_ALIGNMENT
  371.  
  372. #define Transport_Flonum()                        \
  373. {                                    \
  374.   ALIGN_FLOAT (To);                            \
  375.   New_Address = (MAKE_BROKEN_HEART (To));                \
  376.   Real_Transport_Vector ();                        \
  377.   Pointer_End ();                            \
  378. }
  379.  
  380. #else
  381.  
  382. #define Transport_Flonum()                        \
  383. {                                    \
  384.   goto Move_Vector;                            \
  385. }
  386.  
  387. #endif
  388.  
  389. #define Transport_Future()                        \
  390. {                                    \
  391.   if (! (Future_Spliceable (Temp)))                    \
  392.     goto Move_Vector;                            \
  393.   (*Scan) = (Future_Value (Temp));                    \
  394.   Scan -= 1;                                \
  395. }
  396.  
  397. /* Weak Pointer code.  The idea here is to support a post-GC pass which
  398.    removes any objects in the CAR of a WEAK_CONS cell which is no longer
  399.    referenced by other objects in the system.
  400.  
  401.    The idea is to maintain a (C based) list of weak conses in old
  402.    space.  The head of this list is the variable Weak_Chain.  During
  403.    the normal GC pass, weak cons cells are not copied in the normal
  404.    manner. Instead the following structure is built:
  405.  
  406.      Old Space             |          New Space
  407.  _______________________   |   _______________________
  408.  |Broken |     New     |   |   | NULL | Old CAR data |
  409.  |Heart  |  Location ======|==>|      |              |
  410.  |_______|_____________|   |   |______|______________|
  411.  |Old Car| Next in     |   |   |  Old CDR component  |
  412.  | type  |  chain      |   |   |                     |
  413.  |_____________________|   |   |_____________________|
  414.  
  415.  */
  416.  
  417. extern SCHEME_OBJECT Weak_Chain;
  418.  
  419. #define Transport_Weak_Cons()                        \
  420. {                                    \
  421.   long Car_Type = (OBJECT_TYPE (*Old));                    \
  422.   (*To++) = (OBJECT_NEW_TYPE (TC_NULL, (*Old)));            \
  423.   Old += 1;                                \
  424.   (*To++) = (*Old);                            \
  425.   *Old = (OBJECT_NEW_TYPE (Car_Type, Weak_Chain));            \
  426.   Weak_Chain = Temp;                            \
  427.   Pointer_End ();                            \
  428. }
  429.  
  430. /* Special versions of the above for DumpLoop in Fasdump.  This code
  431.    only differs from the code above in that it must check whether
  432.    there is enough space to remember the fixup. */
  433.  
  434. #define Fasdump_Setup_Pointer(Extra_Code, BH_Code)            \
  435. {                                    \
  436.   BH_Code;                                \
  437.                                     \
  438.   /* It must be transported to New Space */                \
  439.                                     \
  440.   New_Address = (MAKE_BROKEN_HEART (To));                \
  441.   if ((Fixes - To) < FASDUMP_FIX_BUFFER)                \
  442.     {                                    \
  443.       NewFree = To;                            \
  444.       Fixup = Fixes;                            \
  445.       return (PRIM_INTERRUPT);                        \
  446.     }                                    \
  447.   (*--Fixes) = (*Old);                            \
  448.   (*--Fixes) = (ADDRESS_TO_DATUM (Old));                \
  449.   Extra_Code;                                \
  450. }
  451.  
  452. /* Undefine Symbols */
  453.  
  454. #define Fasdump_Symbol(global_value)                    \
  455. {                                    \
  456.   (*To++) = (*Old);                            \
  457.   (*To++) = global_value;                        \
  458.   Pointer_End ();                            \
  459. }
  460.  
  461. #define Fasdump_Variable()                        \
  462. {                                    \
  463.   (*To++) = (*Old);                            \
  464.   (*To++) = UNCOMPILED_VARIABLE;                    \
  465.   (*To++) = SHARP_F;                            \
  466.   Pointer_End ();                            \
  467. }
  468.  
  469. /* Compiled Code Relocation Utilities */
  470.  
  471. #include "cmpgc.h"
  472.